home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / M2PROTOS.ZIP / QCZM.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-10-06  |  37.8 KB  |  1,203 lines

  1. (*# call(o_a_copy => off) *)
  2. (*%T _fcall *)
  3. (*# call(seg_name => QCxm) *)
  4. (*%E *)
  5. (*%F _fcall *)
  6. (*# call(seg_name => null) *)
  7. (*%E *)
  8. (*# module(implementation=>on) *)
  9. (*# data(seg_name => null) *)
  10. (*# data(const_assign => on) *)
  11. IMPLEMENTATION MODULE QCzm;
  12.  
  13. FROM QCcomm IMPORT bs, can, cr, lf, xon, xoff, CommRdData, CommWrData,
  14.     CommWrStr, CommRdDataTest, ComTimedOut, ComAbort, ComNoCarrier;
  15. FROM FioAsm IMPORT DiskFree, PathStr, PathTail, SetFileTime, FileTime;
  16. FROM QCdisp IMPORT QCDef, StatusMessage, IncrDataBytes, ShowTransferTime, Errs,
  17.     FlushLog, DataRegisters, ShowErrorType, ShowFileName, DataLeft, QCDefPtr,
  18.     ShowTimeLeft, Packets, StartDisplay, StopDisplay, Yes, YModem, ZModem;
  19. FROM QCxm IMPORT ReceiveXmodem;
  20. FROM NFIO IMPORT Create, Open, Close, File, RdBin, WrBin, OK, Seek,
  21.     SeekEOF, Exists, Size, EOF;
  22. FROM UTIL IMPORT NUMSET, str32;
  23. FROM CRC IMPORT DoCRC, DoC32;
  24. FROM Com IMPORT commChar, SendBreak, Connected;
  25. FROM QCxmzero IMPORT BPtr, CreateBlock, InterpretBlock, TelinkBlockType;
  26. FROM RBvideo IMPORT Delay;
  27. FROM MiscAsm IMPORT HI, LO, SWAP, LongNot;
  28. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  29. FROM Str IMPORT Concat, Append;
  30. FROM Lib IMPORT Move;
  31. FROM Timer IMPORT StartTimer, ForTransfer, ForPacket;
  32.  
  33. TYPE
  34.     CmdType = (zrqinit, zrinit, zsinit, zack, zfile, zskip, znak, zabort,
  35.                zfin, zrpos, zdata, zeof, zferr, zcrc, zchallenge, zcompl,
  36.                zcan, zfreecnt, zcommand, zstderr, canceled,
  37.                timedout, userabort, disconnected, zok, zerror );
  38.  
  39.     ZRQinitRec = RECORD
  40.          xxx : ARRAY[0..2] OF BYTE;
  41.       CmdFlag: CmdType;
  42.     END;
  43.  
  44.     RFlagType = SET OF (CanFDX, CanOvIO, CanBrk, CanCry, CanLzw, CanFC32,
  45.                        EscCtl, Esc8);
  46.  
  47.     ZRinitRec = RECORD
  48.      RBufSize: CARDINAL;
  49.          xxx : BYTE;
  50.        RFlags: RFlagType
  51.     END;
  52.  
  53.     SFlagType = SET OF ( SF0, SF1, SF2, SF3, SF4, SF5, TEscCtl, TEsc8 );
  54.  
  55.     ZSinitRec = RECORD
  56.          xxx : ARRAY[0..2] OF BYTE;
  57.         SFlags: SFlagType;
  58.     END;
  59.  
  60.     CFlagType = (CfEmpty, CfNoConv, CfNLtoCRLF, CfResume);
  61.     MFlagType1 = (MEmpty, IfNewLong, IfCRC, IfAppend, IfReplace, IfNew);
  62.     MFlagType2 = SET OF ( MF0, MF1, MF2, MF3, MF4, MF5, MF6, MSkipIfAbs );
  63.     TFlagType = (TEmpty, TLZW, TCrypt, TRLE );
  64.  
  65.     ZFileRec = RECORD
  66.         XFlags: SET OF (XF0, XF1, XF2, XF3, XF4, XF5, Sparse);
  67.         TFlags: TFlagType;
  68.         CASE : BOOLEAN OF
  69.           TRUE : MFlags1: MFlagType1;
  70.          |FALSE: MFlags2: MFlagType2;
  71.         END;
  72.         CFlags: CFlagType;
  73.     END;
  74.  
  75.     ZCommandRec = RECORD
  76.          xxx : ARRAY[0..2] OF BYTE;
  77.         CAck : BOOLEAN;
  78.     END;
  79.  
  80.    HeaderType = RECORD
  81.       CASE : BOOLEAN OF
  82.       |FALSE : H : ARRAY[0..8] OF BYTE;
  83.       |TRUE  :
  84.          CASE Cmd: CmdType OF
  85.          zrqinit   : ZRQinit : ZRQinitRec;
  86.          |zrinit   : ZRinit  : ZRinitRec;
  87.          |zsinit   : ZSinit  : ZSinitRec;
  88.          |zfile    : ZFile   : ZFileRec;
  89.          |zcommand : ZCommand: ZCommandRec;
  90.          |zack, zrpos, zdata, zeof, zcrc, zchallenge, zcompl: P : LONGCARD;
  91.          END;
  92.          CASE : BOOLEAN OF
  93.          |FALSE: crc16: CARDINAL;
  94.          |TRUE : crc32: LONGCARD;
  95.          END;
  96.      END
  97.    END;
  98. (*# save *)
  99. (*# call (near_call => on) *)
  100.    ZSendHeaderType = PROCEDURE (CmdType);
  101.    ZReceiveDataType = PROCEDURE ( BPtr, INTEGER): CARDINAL;
  102.  
  103. CONST
  104.     StdRecvRatio = 0; (* Max num of blocks to send without Ack; 0 = infinite *)
  105.  
  106.    ZBUFSIZE   = 1024;
  107.    ZPAD       = 42;  (* '*' *)            ZBIN       = 65;  (* 'A' *)
  108.    ZDLE       = 24;  (* ^X  *)            ZHEX       = 66;  (* 'B' *)
  109.    ZDLEE      = 88;                       ZBIN32     = 67;  (* 'C' *)
  110.  
  111.    ZCRCE      = 104; (* 'h' *)            ZCRCW      = 107; (* 'k' *)
  112.    ZCRCG      = 105; (* 'i' *)            ZRUB0      = 108; (* 'l' *)
  113.    ZCRCQ      = 106; (* 'j' *)            ZRUB1      = 109; (* 'm' *)
  114.  
  115.    BadChar    = 0FFFFH; (* received bad info or bad CRC *)
  116.  
  117.    GotOR      = 100H;                     GotCan     = GotOR + can;
  118.    GotCRCE    = GotOR + ORD('h');         GotCRCQ    = GotOR + ORD('j');
  119.    GotCRCG    = GotOR + ORD('i');         GotCRCW    = GotOR + ORD('k');
  120.  
  121.    ZRinitVals = ZRinitRec( 0, BYTE(0),
  122.                 RFlagType{ CanFDX, CanOvIO, CanBrk, CanFC32 });
  123.  
  124. VAR
  125.    rxhdr,
  126.    txhdr: HeaderType;
  127.    HdrErrCount,         (* Error count for headers, set on entry *)
  128.    rxcount,
  129.    rxtimeout : CARDINAL;
  130.    attn  : str32;
  131.    Buffer: BPtr;
  132.    ZeroBlock: TelinkBlockType;
  133.    ZSendHeader : ZSendHeaderType;
  134.    ZReceiveData : ZReceiveDataType;
  135.  
  136. PROCEDURE ZFileCRC32(VAR f: File): LONGCARD;
  137. VAR crc: LONGCARD; result: CARDINAL;
  138. BEGIN
  139.    crc := 0FFFFFFFFH;
  140.    Seek(f,0);
  141.    REPEAT
  142.       result := RdBin(f,Buffer^,ZBUFSIZE);
  143.       crc := DoC32(Buffer, result, crc)
  144.    UNTIL (result < ZBUFSIZE) OR (NOT OK);
  145.    Seek(f,0);
  146.    RETURN crc
  147. END ZFileCRC32;
  148.  
  149. PROCEDURE ZTimedRead(): CARDINAL;
  150. (* strips parity and ignores xon/xoff characters.*)
  151. VAR c: CARDINAL;
  152. BEGIN
  153.    REPEAT
  154.       c := CommRdDataTest(rxtimeout);
  155.    UNTIL (c>0FF00H)
  156.     OR NOT (SHORTCARD(c) IN NUMSET{xon,xoff,91H,93H});(* not xon/xoff *)
  157.    RETURN c
  158. END ZTimedRead;
  159.  
  160. PROCEDURE ZSendCan;
  161. (* Send a zmodem cancel sequence: 8 cans and 8 backspaces *)
  162. VAR n: SHORTCARD;
  163. BEGIN
  164.     FOR n := 1 TO 8 DO
  165.          CommWrData(can);
  166.          Delay(100)
  167.     END;
  168.     FOR n := 1 TO 8 DO
  169.       CommWrData(bs)
  170.     END
  171. END ZSendCan;
  172.  
  173. PROCEDURE ZPutString(p: ARRAY OF CHAR);
  174. VAR n: CARDINAL;
  175. BEGIN
  176.    n := 0;
  177.    WHILE (n <= HIGH(p)) AND (p[n] > 0C) DO
  178.       CASE p[n] OF
  179.          335C : SendBreak;
  180.         |336C : Delay(2000)
  181.         |ELSE  CommWrData(p[n])
  182.       END;
  183.       INC(n)
  184.    END;
  185.    CommWrData(0)
  186. END ZPutString;
  187.  
  188. PROCEDURE ZPutHex(b: BYTE);
  189. CONST hex = '0123456789abcdef';
  190. BEGIN
  191.    CommWrData(hex[ORD(b) >> 4]);
  192.    CommWrData(hex[ORD(b) MOD 10H])
  193. END ZPutHex;
  194.  
  195. PROCEDURE ZSendHexHeader(C: CmdType);
  196. CONST SendHex = '**' + 30C + 'B'; HexEnd = 15C + 12C;
  197. VAR crc: CARDINAL; n: CARDINAL;
  198. BEGIN
  199.     txhdr.Cmd := C;
  200.     txhdr.crc16 := SWAP(DoCRC(ADR(txhdr), 5, 0));
  201.     n := CommWrStr(SendHex);
  202.     FOR n := 0 TO 6 DO
  203.          ZPutHex(txhdr.H[n]);
  204.     END;
  205.     n := CommWrStr(HexEnd);
  206.     IF (C <> zfin) AND (C <> zack) THEN
  207.          CommWrData(xon);  (* to assure flow   *)
  208.     END;
  209. END ZSendHexHeader;
  210.  
  211. PROCEDURE ZSendBytes(V : ARRAY OF BYTE; count : CARDINAL);
  212. VAR LastWas40H : BOOLEAN; i : CARDINAL; b: SHORTCARD;
  213. BEGIN
  214.     IF count = 0 THEN
  215.          RETURN
  216.     END;
  217.     LastWas40H := FALSE;
  218.     FOR i := 0 TO count -1 DO
  219.          b := SHORTCARD(V[i]);
  220.          IF (b IN NUMSET{10H,11H,13H,18H,90H,91H,93H,98H}) OR
  221.               (LastWas40H AND (b IN NUMSET{0FH, 8FH})) THEN
  222.               INCL(BITSET(b), 6);
  223.               CommWrData(ZDLE);
  224.          END;
  225.          CommWrData(b);
  226.          LastWas40H := SHORTCARD(b) = 40H
  227.     END;
  228. END ZSendBytes;
  229.  
  230. PROCEDURE ZSendHeader32(C: CmdType);
  231. CONST SendBin32Str = '*' + 30C + 'C';
  232. VAR n: CARDINAL;
  233. BEGIN
  234.    txhdr.Cmd := C;
  235.    txhdr.crc32 := LongNot(DoC32(ADR(txhdr), 5, 0FFFFFFFFH));
  236.    n := CommWrStr(SendBin32Str);
  237.    ZSendBytes(txhdr, 9);
  238.    IF C <> zdata THEN
  239.       Delay(500)
  240.    END
  241. END ZSendHeader32;
  242.  
  243. PROCEDURE ZSendHeader16(C: CmdType);
  244. CONST SendBinStr = '*' + 30C + 'A';
  245. VAR crc, n: CARDINAL;
  246. BEGIN
  247.     txhdr.Cmd := C;
  248.     txhdr.crc16 := SWAP(DoCRC(ADR(txhdr), 5, 0));
  249.     n := CommWrStr(SendBinStr);
  250.     ZSendBytes(txhdr, 7);
  251.     IF C <> zdata THEN
  252.          Delay(500)
  253.     END
  254. END ZSendHeader16;
  255.  
  256. PROCEDURE ZGetZDL(): CARDINAL;
  257. (* Gets byte and processes for ZMODEM escaping or cancel sequence *)
  258. VAR c, n: CARDINAL;
  259. BEGIN
  260.     c := CommRdDataTest(rxtimeout);
  261.     IF c <> ZDLE THEN
  262.          RETURN c
  263.     END;   (*got ZDLE or 1st can*)
  264.     n := 0;
  265.     REPEAT
  266.          c := CommRdData(rxtimeout);
  267.          INC(n);
  268.     UNTIL (n >= 5) OR (c <> ZDLE);
  269.    (* Flags set in high byte *)
  270.     CASE c OF
  271.       can: RETURN GotCan; (* 5th can, same as ZDLE *)
  272.    |ZCRCE,                    (*frame end marker*)
  273.     ZCRCG,
  274.     ZCRCQ,
  275.     ZCRCW: RETURN c + GotOR;
  276.    |ZRUB0: RETURN 007FH; (*got an ASCII DELete*)
  277.    |ZRUB1: RETURN 00FFH  (*any parity         *)
  278.    |ELSE   IF c > 0FF00H THEN
  279.               RETURN c
  280.            ELSIF (6 IN BITSET(c)) AND (NOT (5 IN BITSET(c))) THEN
  281.               RETURN c - 40H
  282.            ELSE
  283.               RETURN BadChar
  284.            END
  285.    END
  286. END ZGetZDL;
  287.  
  288. PROCEDURE ZReceiveDa32(buf: BPtr; blength: INTEGER): CARDINAL;
  289. (* Returns frame end character *)
  290. VAR c, FrameEnd, n: CARDINAL; crc: LONGCARD;
  291. BEGIN
  292.     rxcount := 0;
  293.     LOOP
  294.          c := ZGetZDL();
  295.          IF c >= 100H THEN
  296.               EXIT
  297.          END;
  298.          DEC(blength);
  299.          IF (blength < 0) THEN
  300.               StatusMessage('Packet is too long', FALSE);
  301.               RETURN BadChar;
  302.          END;
  303.          INC(rxcount);
  304.          buf^[rxcount] := BYTE(c);
  305.     END; (* LOOP *)
  306.     IF (c >= GotCRCE) AND (c <= GotCRCW) THEN
  307.          FrameEnd := c;
  308.          INC(rxcount);
  309.          buf^[rxcount] := BYTE(c);
  310.          n := 1;
  311.          LOOP
  312.               c := ZGetZDL();
  313.               IF c > 100H THEN
  314.                    DEC(rxcount, n); (* subtract FrameEnd and CRC *)
  315.                    EXIT
  316.               END;
  317.               INC(rxcount);
  318.               buf^[rxcount] := BYTE(c);
  319.               INC(n);
  320.               IF n > 4 THEN
  321.                    crc := DoC32(buf, rxcount, 0FFFFFFFFH);
  322.                    DEC(rxcount, n);    (* subtract FrameEnd and CRC *)
  323.                    INC( DataRegisters[TRUE, Packets]);
  324.                    IF crc <> 0DEBB20E3H THEN
  325.                         INC(DataRegisters[ TRUE, Errs]);
  326.                         RETURN BadChar
  327.                    ELSE
  328.                         RETURN FrameEnd;
  329.                    END;
  330.               END;
  331.          END;
  332.     END;
  333.     CASE c OF
  334.          |GotCan : StatusMessage('Transfer canceled', FALSE);
  335.                    RETURN c;
  336.      |ComTimedOut,
  337.         ComAbort : RETURN c;
  338.    |ComNoCarrier : StatusMessage('Lost carrier', TRUE);
  339.                    RETURN c;
  340.              ELSE  WHILE CommRdData( 0 ) < ComAbort DO END; (* flush *)
  341.                    RETURN c
  342.     END; (* CASE *)
  343. END ZReceiveDa32;
  344.  
  345. PROCEDURE ZReceiveDa16(buf: BPtr; blength: INTEGER): CARDINAL;
  346. (* Returns frame end character *)
  347. VAR c, crc, n, FrameEnd : CARDINAL;
  348. BEGIN
  349.     rxcount := 0;
  350.     LOOP
  351.          c := ZGetZDL();
  352.          IF c >= 100H THEN
  353.               EXIT
  354.          END;
  355.          DEC(blength);
  356.          IF (blength < 0) THEN
  357.               StatusMessage('Packet is too long', FALSE);
  358.               RETURN BadChar;
  359.          END;
  360.          INC(rxcount);
  361.          buf^[rxcount] := BYTE(c);
  362.     END; (* LOOP *)
  363.     IF (c >= GotCRCE) AND (c <= GotCRCW) THEN
  364.          INC(rxcount);
  365.          buf^[rxcount] := BYTE(c);
  366.          FrameEnd := c;
  367.          n := 1;
  368.          LOOP
  369.               c := ZGetZDL();
  370.               IF c > 100H THEN
  371.                    DEC(rxcount, n); (* Take off FrameEnd, crc *)
  372.                    EXIT
  373.               END;
  374.               INC(rxcount);
  375.               buf^[rxcount] := BYTE(c);
  376.               INC(n);
  377.               IF n > 2 THEN
  378.                    crc := DoCRC(buf, rxcount, 0);
  379.                    DEC(rxcount, n); (* Take off FrameEnd, crc *)
  380.                    INC( DataRegisters[TRUE, Packets]);
  381.                    IF crc > 0 THEN
  382.                         INC(DataRegisters[ TRUE, Errs]);
  383.                         RETURN BadChar
  384.                    ELSE
  385.                         RETURN FrameEnd
  386.                    END;
  387.               END;
  388.          END;
  389.     END;
  390.     CASE c OF
  391.          |GotCan : StatusMessage('Transfer canceled', FALSE);
  392.                    RETURN c;
  393.      |ComTimedOut,
  394.         ComAbort : RETURN c;
  395.    |ComNoCarrier : StatusMessage('Lost carrier', TRUE);
  396.                    RETURN c;
  397.              ELSE  WHILE CommRdData( 0 ) < ComAbort DO END; (* flush *)
  398.                    RETURN c
  399.     END; (* CASE *)
  400. END ZReceiveDa16;
  401.  
  402. PROCEDURE ZGetHeader(): CmdType;
  403. TYPE GetHedStateType = (GetZpad, GetZdle, GetFrame);
  404. VAR c, errcount, cancount: CARDINAL; HedState : GetHedStateType;
  405.     HaveGarbage: BOOLEAN;
  406.  
  407.     PROCEDURE ZGetHexHeader(): CmdType;
  408.     VAR crc, c, n: CARDINAL;
  409.  
  410.          PROCEDURE ZGetHex(): CARDINAL;
  411.          VAR c, n: CARDINAL;
  412.          BEGIN
  413.             n := ZTimedRead();
  414.             IF n > 100H THEN
  415.                RETURN n
  416.             END;
  417.             DEC(n, 30H);
  418.             IF (n > 9) THEN
  419.                DEC(n, 39)
  420.             END;
  421.             IF (n > 0FH) OR (n < 0) THEN
  422.                RETURN BadChar;
  423.             END;
  424.             c := ZTimedRead();
  425.             IF c > 100H THEN
  426.                RETURN c
  427.             END;
  428.             DEC(c, 30H);
  429.             IF c > 9 THEN
  430.                DEC(c, 39);
  431.             END;
  432.             IF (c > 0FH) OR (c < 0) THEN
  433.                RETURN BadChar;
  434.             END;
  435.             RETURN (n << 4) + c
  436.          END ZGetHex;
  437.  
  438.     BEGIN
  439.         FOR n := 0 TO 6 DO
  440.           c := ZGetHex();
  441.           IF c > 0FF00H THEN
  442.              CASE c OF
  443.                 ComNoCarrier : RETURN disconnected;
  444.                 |ComTimedOut : RETURN timedout;
  445.                    |ComAbort : RETURN userabort;
  446.                      |GotCan : RETURN canceled;
  447.              END;
  448.           END;
  449.           rxhdr.H[n] := BYTE(c);
  450.        END;
  451.        crc := DoCRC(ADR(rxhdr), 7, 0);
  452.        IF (crc > 0) THEN
  453.           INC(DataRegisters[ TRUE, Errs]);
  454.           rxhdr.Cmd := zerror;
  455.        END;
  456.        IF CommRdData(1) = ORD(cr) THEN           (*throw away CR/LF*)
  457.           c := CommRdData(1)
  458.        END;
  459.        RETURN rxhdr.Cmd
  460.     END ZGetHexHeader;
  461.  
  462.     PROCEDURE ZGetBinaryHeader(): CmdType;
  463.     VAR crc, n, c: CARDINAL;
  464.     BEGIN
  465.        FOR n := 0 TO 6 DO
  466.           c := ZGetZDL();
  467.           IF c >= 100H THEN
  468.              CASE c OF
  469.                 ComNoCarrier : RETURN disconnected;
  470.                 |ComTimedOut : RETURN timedout;
  471.                    |ComAbort : RETURN userabort;
  472.                      |GotCan : RETURN canceled;
  473.              END;
  474.           END;
  475.           rxhdr.H[n] := SHORTCARD(c);
  476.        END;
  477.        crc := DoCRC(ADR(rxhdr),7, 0);
  478.        IF crc > 0 THEN
  479.           INC(DataRegisters[ TRUE, Errs]);
  480.           rxhdr.Cmd := zerror;
  481.        END;
  482.        RETURN rxhdr.Cmd
  483.     END ZGetBinaryHeader;
  484.  
  485.     PROCEDURE ZGetBinaryHead32(): CmdType;
  486.     VAR crc: LONGCARD; c, n: CARDINAL;
  487.     BEGIN
  488.          FOR n := 0 TO 8 DO
  489.               c := ZGetZDL();
  490.               IF c >= 100H THEN
  491.                    CASE c OF
  492.                 ComNoCarrier : RETURN disconnected;
  493.                 |ComTimedOut : RETURN timedout;
  494.                    |ComAbort : RETURN userabort;
  495.                      |GotCan : RETURN canceled;
  496.                    END;
  497.               END;
  498.               rxhdr.H[n] := SHORTCARD(c);
  499.          END;
  500.          crc := DoC32(ADR(rxhdr),9, 0FFFFFFFFH);
  501.          IF (crc <> 0DEBB20E3H) THEN
  502.               INC(DataRegisters[ TRUE, Errs]);
  503.               rxhdr.Cmd := zerror;
  504.          END;
  505.          RETURN rxhdr.Cmd
  506.     END ZGetBinaryHead32;
  507.  
  508. BEGIN (* ZGetHeader *)
  509.     errcount := HdrErrCount;
  510.     HedState := GetZpad;
  511.     cancount := 4;
  512.     HaveGarbage := FALSE;
  513.     LOOP
  514.          c := ZTimedRead();
  515.          CASE HedState OF
  516.     |GetZpad: IF c = ZPAD THEN
  517.                    INC(HedState)
  518.               ELSE
  519.                    HaveGarbage := TRUE;
  520.               END;
  521.     |GetZdle: CASE c OF
  522.                  |ZDLE: INC(HedState)
  523.                  |ZPAD: ; (* deja vu *)
  524.                  |ELSE HaveGarbage := TRUE;
  525.               END;
  526.    |GetFrame: CASE c OF
  527.                ZBIN32: ZReceiveData := ZReceiveDa32;
  528.                        RETURN ZGetBinaryHead32();
  529.                 |ZBIN: ZReceiveData := ZReceiveDa16;
  530.                        RETURN ZGetBinaryHeader();
  531.                 |ZHEX: RETURN ZGetHexHeader();
  532.                 |ELSE HaveGarbage := TRUE;
  533.               END;
  534.          END; (* CASE HedState *)
  535.          WHILE HaveGarbage DO
  536.               CASE c OF
  537.          |ComNoCarrier: RETURN disconnected;
  538.           |ComTimedOut: RETURN timedout;
  539.              |ComAbort: RETURN userabort;
  540.                   |can: DEC(cancount);
  541.                         IF (cancount = 0) THEN
  542.                              RETURN canceled;
  543.                         END;
  544.                         c := ZTimedRead();
  545.                   |ELSE DEC(errcount);
  546.                         IF errcount = 0 THEN
  547.                              INC(DataRegisters[ TRUE, Errs]);
  548.                              StatusMessage('Header is bad', FALSE);
  549.                              RETURN zerror;
  550.                         END;
  551.                         cancount := 4; (* restore *)
  552.                         HaveGarbage := FALSE; (* reset *)
  553.                         IF c = ZPAD THEN
  554.                              HedState := GetZdle
  555.                         ELSE
  556.                              HedState := GetZpad; (* Start over *)
  557.                         END;
  558.               END; (* CASE *)
  559.          END; (* WHILE *)
  560.     END; (* ZPAD LOOP *)
  561. END ZGetHeader;
  562. (*# restore *)
  563.  
  564. (*---------*)
  565. (* RECEIVE *)
  566. (*---------*)
  567.  
  568. PROCEDURE ReceiveZmodem( FilePath : PathStr );
  569.  
  570. VAR
  571.    Fo: File;
  572.    filestart: LONGCARD;
  573.    zconversion: CFlagType;
  574.  
  575. PROCEDURE RecvAckExit;
  576. VAR n: CARDINAL;
  577. BEGIN
  578.     txhdr.P := rxhdr.P;
  579.     n := 4;
  580.     WHILE CommRdData( 0 ) < ComAbort DO END; (* flush *)
  581.     LOOP
  582.          ZSendHexHeader(zfin);
  583.          CASE CommRdData(20) OF
  584. |ComTimedOut,
  585.     ComAbort,
  586. ComNoCarrier: RETURN;
  587.          |79: IF (CommRdData(10) = 79) THEN END;
  588.                    EXIT;
  589.         |ELSE EXIT
  590.          END; (* CASE *)
  591.          IF n = 0 THEN EXIT END;
  592.     END; (* LOOP *)
  593.     WHILE CommRdData( 0 ) < ComAbort DO END; (* flush *)
  594. END RecvAckExit;
  595.  
  596. PROCEDURE InitReceiver(TryZHdr: CmdType): CmdType;
  597. (* possible returns: zfile:    zero block has file info;
  598.                      timedout: sender not responding; try YModem;
  599.                      zerror:   no sender or transfer aborted;
  600.                      zcompl:   sender is finished *)
  601. VAR c, TimeOuts : CARDINAL; SetZero : BOOLEAN;
  602. BEGIN
  603.     attn[0] := 0C;
  604.     TimeOuts := 0;
  605.     SetZero := TRUE; (* Default is send zero in header flags *)
  606.     LOOP
  607.          IF TryZHdr = zrinit THEN
  608.               txhdr.ZRinit := ZRinitVals
  609.          ELSIF SetZero THEN
  610.               txhdr.P := 0
  611.          ELSE
  612.               SetZero := TRUE;
  613.          END;
  614.          ZSendHexHeader(TryZHdr);
  615.          IF TryZHdr = zskip THEN
  616.               TryZHdr := zrinit
  617.          END;
  618.          CASE ZGetHeader() OF
  619.             zfile: zconversion := rxhdr.ZFile.CFlags;
  620.                    TryZHdr := zrinit;
  621.                    c := ZReceiveData(Buffer,ZBUFSIZE);
  622.                    IF (c = GotCRCW) THEN
  623.                         RETURN zfile;
  624.                    END;
  625.                    TryZHdr := znak;
  626.           |zsinit: c := ZReceiveData(ADR(attn),SIZE(attn));
  627.                    IF (c = GotCRCW) THEN
  628.                         TryZHdr := zack;
  629.                    ELSE
  630.                         TryZHdr := znak;
  631.                    END;
  632.         |zfreecnt: txhdr.P := DiskFree(0, c); (* use c as dummy variable *)
  633.                    SetZero := FALSE; (* don't overwrite DiskFree *)
  634.         |zcommand: c := ZReceiveData(Buffer,ZBUFSIZE);
  635.                    IF (c = GotCRCW) THEN
  636.                         TryZHdr := zcompl;
  637.                    ELSE
  638.                         TryZHdr := znak;
  639.                    END;
  640.           |zcompl,
  641.              zfin: RETURN zcompl;
  642.        |canceled,
  643.        userabort,
  644.     disconnected : RETURN zerror;
  645.        |timedout : INC(TimeOuts);
  646.                    IF TimeOuts > 3 THEN
  647.                         StatusMessage('Timeout', FALSE);
  648.                         RETURN timedout;
  649.                    END;
  650.          END  (* CASE *)
  651.       END (* LOOP *)
  652. END InitReceiver;
  653.  
  654. PROCEDURE GetFileInfo(): CmdType;
  655. VAR tsize: LONGCARD; s, fname: PathStr;
  656. (* returns zack to continue download; zskip to skip; zerror to abort *)
  657.  
  658. PROCEDURE CrcsMatch(): BOOLEAN;
  659. VAR tries: CARDINAL;
  660. BEGIN
  661.     txhdr.P := ZFileCRC32(Fo);
  662.     tries := 4;
  663.     LOOP
  664.          ZSendHexHeader(zcrc);
  665.          IF ZGetHeader() = zcrc THEN
  666.               RETURN txhdr.P = rxhdr.P
  667.          END;
  668.          DEC(tries);
  669.          IF tries = 0 THEN
  670.               RETURN FALSE
  671.          END
  672.     END;
  673. END CrcsMatch;
  674.  
  675. BEGIN
  676.     InterpretBlock[ZModem] (Buffer, ZeroBlock );
  677.     Concat( fname, FilePath, ZeroBlock.FileName);
  678.     IF Exists(fname) THEN
  679.          Fo := Open(fname);
  680.          tsize := Size(Fo);
  681.          IF (Fo = MAX(CARDINAL)) OR NOT OK THEN
  682.               StatusMessage('Error opening file', TRUE);
  683.               RETURN zerror;
  684.          END;
  685.          IF (zconversion = CfResume) AND (ZeroBlock.FileLength > tsize)
  686.             AND (ZeroBlock.FileTime = FileTime(Fo))
  687.             AND Yes('File exists. Do you wish to resume downloading?') THEN
  688.               filestart := tsize;
  689.               SeekEOF(Fo);
  690.               StatusMessage('Recovering', FALSE)
  691.          ELSIF (ZeroBlock.FileLength = tsize) AND CrcsMatch() THEN
  692.               Concat(s, fname, ' is already complete');
  693.               StatusMessage(s, TRUE);
  694.               Close(Fo);
  695.               RETURN zskip;
  696.          ELSIF Yes('File exists. Do you wish to overwrite it?') THEN
  697.               filestart := 0;
  698.               Fo := Create(fname);
  699.               IF Fo = MAX(CARDINAL) THEN
  700.                    StatusMessage('Unable to create file', TRUE);
  701.                    RETURN zerror
  702.               END
  703.          ELSE
  704.               Close(Fo);
  705.               RETURN zskip;
  706.          END
  707.     ELSE
  708.          filestart := 0;
  709.          Fo := Create(fname);
  710.          IF Fo = MAX(CARDINAL) THEN
  711.               StatusMessage('Unable to create file', TRUE);
  712.               RETURN zerror
  713.          END
  714.     END;
  715.     ShowFileName(fname, TRUE);
  716.     DataRegisters[TRUE, DataLeft] := ZeroBlock.FileLength;
  717.     ShowTimeLeft( TRUE );
  718.     RETURN zack
  719. END GetFileInfo;
  720.  
  721. PROCEDURE ZReceiveFile(): CmdType;
  722. (* possible returns: zerror: any error;
  723.                      zrinit: successfully completed -- passed to InitReceiver
  724.                       zskip: transfer skipped *)
  725.  
  726. VAR c: CmdType; d, tries: CARDINAL; rxbytes: LONGCARD;
  727.  
  728. PROCEDURE SaveToDisk(VAR rx: LONGCARD): BOOLEAN;
  729. BEGIN
  730.    WrBin(Fo,Buffer^,rxcount);
  731.    IF NOT OK THEN
  732.       StatusMessage('Disk write error', TRUE);
  733.       RETURN FALSE
  734.    END;
  735.    INC(rx, VAL(LONGCARD, rxcount));
  736.    IncrDataBytes( rxcount, TRUE );
  737.    RETURN TRUE
  738. END SaveToDisk;
  739.  
  740. BEGIN (* ZReceiveFile *)
  741.     CASE GetFileInfo() OF
  742.          zskip : RETURN zskip;
  743.        |zerror : RETURN zerror;
  744.     END;
  745.     c := zack;
  746.     tries := 10;
  747.     rxbytes := filestart;
  748.     txhdr.P := rxbytes;
  749.     ZSendHexHeader(zrpos);
  750.     StartTimer(ForPacket);
  751.     StartTimer(ForTransfer);
  752.     LOOP
  753.       CASE ZGetHeader() OF
  754.          zdata: IF (rxhdr.P <> rxbytes) THEN
  755.                    INC(DataRegisters[ TRUE, Errs]);
  756.                    IF (tries = 0) THEN
  757.                       RETURN zerror
  758.                    END;
  759.                    DEC(tries);
  760.                    StatusMessage('Bad position', TRUE);
  761.                    ZPutString(attn);
  762.                    txhdr.P := rxbytes;
  763.                    ZSendHexHeader(zrpos);
  764.                 ELSE
  765.                    LOOP
  766.                       d := ZReceiveData(Buffer,ZBUFSIZE);
  767.                       CASE d OF
  768.                       |GotCan,
  769.                      ComAbort,
  770.                  ComNoCarrier: RETURN zerror;
  771.                  |ComTimedOut: IF tries = 0 THEN
  772.                                   RETURN zerror
  773.                                END;
  774.                                DEC(tries);
  775.                                txhdr.P := rxbytes;
  776.                                ZSendHexHeader(zrpos);
  777.                                EXIT;
  778.             |GotCRCE..GotCRCW: tries := 10;
  779.                                IF NOT SaveToDisk(rxbytes) THEN
  780.                                  RETURN zerror
  781.                                END;
  782.                                IF (d  = GotCRCQ) OR (d  = GotCRCW) THEN
  783.                                   txhdr.P := rxbytes;
  784.                                   ZSendHexHeader(zack);
  785.                                END;
  786.                                IF (d  = GotCRCW) OR (d  = GotCRCE) THEN
  787.                                   EXIT;
  788.                                END;
  789.                         ELSE   INC(DataRegisters[TRUE, Errs]); (* Debris *)
  790.                                IF tries = 0 THEN
  791.                                   RETURN zerror;
  792.                                END;
  793.                                DEC(tries);
  794.                                ZPutString(attn);
  795.                                txhdr.P := rxbytes;
  796.                                ZSendHexHeader(zrpos);
  797.                                EXIT;
  798.                           END (*CASE*)
  799.                      END (* LOOP *)
  800.                 END; (* ELSE *)
  801.         |znak,
  802.       timedout: IF tries = 0 THEN
  803.                    RETURN zerror
  804.                 END;
  805.                 DEC(tries);
  806.                 txhdr.P := rxbytes;
  807.                 ZSendHexHeader(zrpos);
  808.         |zfile: d := ZReceiveData(Buffer,ZBUFSIZE);
  809.                 txhdr.P := rxbytes;
  810.                 ZSendHexHeader(zrpos);
  811.          |zeof: IF rxhdr.P = rxbytes THEN
  812.                   RETURN zrinit  (* passed to InitReceiver *)
  813.                 END;
  814.        |zerror: IF tries = 0 THEN
  815.                   RETURN zerror
  816.                 END;
  817.                 DEC(tries);
  818.                 ZPutString(attn);
  819.                 txhdr.P := rxbytes;
  820.                 ZSendHexHeader(zrpos);
  821.          |ELSE  RETURN zerror
  822.       END (*CASE*)
  823.    END; (* LOOP *)
  824. END ZReceiveFile;
  825.  
  826. VAR c: CmdType;
  827. BEGIN (* ReceiveZmodem *)
  828.     HdrErrCount := 600 << ORD(QCDefPtr^.baud);
  829.     WHILE CommRdData( 0 ) < ComAbort DO END; (* flush *)
  830.     FlushLog;
  831.     StartDisplay( TRUE, ZModem, TRUE);
  832.     NEW ( Buffer );
  833.     rxtimeout := 100;
  834.     CASE InitReceiver(zrinit) OF
  835.          timedout: (* QCDefPtr^.Protocol *) QCDef.Protocol := YModem;
  836.                    StatusMessage('No ZModem response; Trying YModem', FALSE);
  837.                    DISPOSE( Buffer );
  838.                    StopDisplay;
  839.                    ReceiveXmodem( FilePath, '' );
  840.                    (* QCDefPtr^.Protocol *) QCDef.Protocol := ZModem;
  841.                    RETURN;
  842.          |zerror:  StatusMessage('Aborting transfer', FALSE);
  843.                    DISPOSE( Buffer );
  844.                    StopDisplay;
  845.                    RETURN;
  846.          |zcompl:  StatusMessage('Transfer complete', FALSE);
  847.                    DISPOSE( Buffer );
  848.                    StopDisplay;
  849.                    RETURN;
  850.     END;
  851.     LOOP
  852.          c := ZReceiveFile();
  853.          IF SetFileTime(Fo,ZeroBlock.FileTime) THEN END;
  854.          ShowTransferTime;
  855.          Close(Fo);
  856.          CASE c OF
  857.             |zrinit,
  858.               zskip: CASE InitReceiver(c) OF
  859.                    |zfile:; (* go through next loop *);
  860.                    |zcompl: RecvAckExit;
  861.                             EXIT;
  862.                    |ELSE    StatusMessage('Canceling transmission', FALSE);
  863.                             ZSendCan;
  864.                             EXIT
  865.                 END;
  866.         |ELSE EXIT;
  867.       END (*CASE*)
  868.    END; (*LOOP*)
  869.    DISPOSE( Buffer );
  870.    StopDisplay;
  871. END ReceiveZmodem;
  872.  
  873. (* SEND *)
  874. (*# save *)
  875. (*# call (near_call => on) *)
  876.  
  877. TYPE
  878.    ZSendDataType =  PROCEDURE ( BPtr, CARDINAL, SHORTCARD);
  879.  
  880. PROCEDURE ZSendDa32(buf: BPtr; blength: CARDINAL; FrameEnd: SHORTCARD);
  881. VAR n: CARDINAL; crc: LONGCARD;
  882. BEGIN
  883.     n := blength + 1;
  884.     buf^[n] := FrameEnd;         (* put this at end to calculate *)
  885.     crc := LongNot(DoC32(buf, n, 0FFFFFFFFH));
  886.     ZSendBytes(buf^, blength);
  887.     CommWrData(ZDLE);
  888.     CommWrData(FrameEnd);
  889.     ZSendBytes(crc, 4);
  890.     INC( DataRegisters[FALSE, Packets]);
  891.     IF FrameEnd = ZCRCW THEN
  892.          CommWrData(xon);
  893.          Delay(500)
  894.     END
  895. END ZSendDa32;
  896.  
  897. PROCEDURE ZSendDa16( buf: BPtr; blength: CARDINAL; FrameEnd: SHORTCARD);
  898. VAR crc, n: CARDINAL;
  899. BEGIN
  900.     n := blength + 1;
  901.     buf^[n] := FrameEnd;                     (* put this at end to calculate *)
  902.     crc := SWAP(DoCRC(buf, blength+1, 0 ));
  903.     ZSendBytes(buf^, blength);
  904.     CommWrData(ZDLE);
  905.     CommWrData(FrameEnd);
  906.     ZSendBytes(crc, 2);
  907.     INC( DataRegisters[FALSE, Packets]);
  908.     IF (ORD(FrameEnd) = ZCRCW) THEN
  909.          CommWrData(xon);
  910.          Delay(500)
  911.     END
  912. END ZSendDa16;
  913.  
  914. (*# restore *)
  915. PROCEDURE SendZmodem( ThisFile: FilePtr );
  916. VAR
  917. Fi  : File;
  918. BlockZeroLen,
  919. BlockLength,            (* length of next sub-block to send *)
  920. MaxLength,              (* maximum length of any sub-block *)
  921. RecvRatio : CARDINAL;   (* number of sub-blocks receiver can swallow at once *)
  922. txpos : LONGCARD;
  923. ZSendData   : ZSendDataType;
  924.  
  925. PROCEDURE SendAckExit;
  926. VAR dummy: CARDINAL;
  927. BEGIN
  928.     txhdr.P := txpos;
  929.     LOOP
  930.          ZSendHeader(zfin);
  931.          CASE ZGetHeader() OF
  932.          zfin: dummy := CommWrStr('OO');
  933.                Delay(500);
  934.                (* ClearOutput; *)
  935.                RETURN
  936.     |canceled,
  937.     userabort,
  938.  disconnected,
  939.         zferr,
  940.      timedout: RETURN
  941.          END (*CASE*)
  942.    END (* LOOP *)
  943. END SendAckExit;
  944.  
  945. PROCEDURE GetReceiverInfo(): BOOLEAN;
  946. CONST StartStr = 'rz'+15C;
  947. VAR rxflags, n: CARDINAL;
  948. BEGIN
  949.     attn[0] := 0C;
  950.     txhdr.P := 0;
  951.     ZPutString(StartStr);
  952.     n := 10;
  953.     ZSendHexHeader(zrqinit);
  954.     LOOP
  955.          CASE ZGetHeader() OF
  956.        zchallenge: txhdr.P := rxhdr.P;
  957.                    ZSendHexHeader(zack);
  958.         |zcommand: txhdr.P := 0;
  959.                    ZSendHexHeader(zrqinit);
  960.           |zrinit: IF rxhdr.ZRinit.RBufSize > 0 THEN
  961.                         IF rxhdr.ZRinit.RBufSize < MaxLength THEN
  962.                              MaxLength := rxhdr.ZRinit.RBufSize
  963.                         END;
  964.                         RecvRatio := rxhdr.ZRinit.RBufSize MOD MaxLength;
  965.                    ELSE
  966.                         RecvRatio := StdRecvRatio
  967.                    END;
  968.                    IF CanFC32 IN rxhdr.ZRinit.RFlags THEN
  969.                         ZSendHeader := ZSendHeader32;
  970.                         ZSendData  := ZSendDa32;
  971.                    END;
  972.                    ShowErrorType(TRUE); (* Change to show usecrc32 *);
  973.                    RETURN TRUE
  974.         |canceled,
  975.      disconnected,
  976.         userabort: RETURN FALSE;
  977.         |timedout: StatusMessage('Timeout on initialization.', FALSE);
  978.                    ZSendHexHeader(zrqinit);
  979.          |zrqinit: IF rxhdr.ZRQinit.CmdFlag <> zcommand THEN
  980.                         RETURN FALSE
  981.                    END;
  982.             |ELSE  ZSendHexHeader(znak);
  983.          END; (* CASE *)
  984.          DEC(n);
  985.          IF n = 0 THEN
  986.               RETURN FALSE
  987.          END;
  988.     END; (* LOOP *)
  989. END GetReceiverInfo;
  990.  
  991. PROCEDURE ZSendFile(): CmdType;
  992.  
  993. PROCEDURE ZSendFileData(): CmdType;
  994. (* returns zerror, zskip or zok *)
  995. TYPE SendStateType = (SendDHdr, SendSubBlock, SendEOF, EOFSent);
  996. VAR c: CmdType; WaitAck : BOOLEAN; SendState : SendStateType; Quality: INTEGER;
  997.     errcheck, BlockRead, RecvCycle: CARDINAL; HighestPos: LONGCARD;
  998.  
  999. PROCEDURE ZSendResync(): CmdType;
  1000. (* Returns zack, zskip, zrpos, zrinit or zerror *)
  1001. VAR Cd: CmdType;
  1002.  
  1003. BEGIN
  1004.     Cd := ZGetHeader();
  1005.     WHILE CommRdData( 0 ) < ComAbort DO END; (* flush *)
  1006.     CASE Cd OF
  1007.       |zrpos: Seek(Fi,rxhdr.P);
  1008.               IF NOT OK THEN
  1009.                    StatusMessage('File seek error', FALSE);
  1010.                    RETURN zerror;
  1011.               END;
  1012.               txpos := rxhdr.P;
  1013.               DEC(Quality);
  1014.               RETURN zrpos;
  1015.       |zskip: RETURN zskip;
  1016.    |canceled,
  1017.     timedout,
  1018.       zabort,
  1019.         zfin,
  1020.    userabort,
  1021. disconnected: RETURN zerror;
  1022.      |zrinit: RETURN zrinit;
  1023.        |zack: RETURN zack;
  1024.         |ELSE ZSendHeader(znak)
  1025.     END (*CASE*)
  1026. END ZSendResync;
  1027.  
  1028. BEGIN (* ZSendFileData *)
  1029.     WaitAck := FALSE;
  1030.     SendState := SendDHdr;
  1031.     Quality := 0;
  1032.     HighestPos := txpos;
  1033.     LOOP (* Main *)
  1034.          IF WaitAck OR commChar() THEN
  1035.               c := ZSendResync();
  1036.               CASE c OF
  1037.                  zskip: RETURN zskip;
  1038.                  |zack: ; (*null*)
  1039.                 |zrpos: INC(DataRegisters[FALSE, Errs]);
  1040.                         DEC(Quality);
  1041.                         IF BlockLength > 80H THEN
  1042.                              BlockLength := BlockLength >> 2
  1043.                         ELSE
  1044.                              BlockLength := 20H
  1045.                         END;
  1046.                         IF SendState = SendSubBlock THEN
  1047.                              ZSendData(Buffer, 0, ZCRCE);
  1048.                              SendState := SendDHdr;
  1049.                         END;
  1050.                |zrinit: RETURN zrinit;
  1051.                   |ELSE RETURN zerror;
  1052.               END (*CASE*);
  1053.          ELSE
  1054.               c := zack (* no news is good news *)
  1055.          END;
  1056.          CASE SendState OF
  1057.               SendDHdr: txhdr.P := txpos;
  1058.                         ZSendHeader(zdata);
  1059.                         INC(SendState);
  1060.                         RecvCycle := 0;
  1061.          |SendSubBlock: BlockRead := RdBin(Fi, Buffer^, BlockLength);
  1062.                         INC(RecvCycle);
  1063.                         IF EOF(Fi) THEN
  1064.                              errcheck := ZCRCE;
  1065.                              WaitAck := FALSE;
  1066.                              INC(SendState);
  1067. (*DIAG: EOF error here?*)
  1068.                         ELSIF NOT OK THEN
  1069.                              StatusMessage('Error reading disk', FALSE);
  1070.                              ZSendCan;
  1071.                              RETURN zerror;
  1072.                         ELSIF (RecvRatio > 0) AND (RecvCycle = RecvRatio) THEN
  1073.                              RecvCycle := 0;
  1074.                              errcheck := ZCRCQ
  1075.                         ELSE
  1076.                              errcheck := ZCRCG
  1077.                         END;
  1078.                         ZSendData(Buffer, BlockRead, SHORTCARD(errcheck));
  1079.                         INC(txpos, VAL(LONGCARD,BlockRead));
  1080.                         IncrDataBytes( BlockRead, FALSE );
  1081.                         INC(Quality);
  1082.                         IF (BlockLength < MaxLength) AND (Quality > 0)
  1083.                          AND (txpos > HighestPos) THEN
  1084.                              IF ((BlockLength << 1) < MaxLength) THEN
  1085.                                   BlockLength := (BlockLength << 1)
  1086.                              ELSE
  1087.                                   BlockLength := MaxLength
  1088.                              END;
  1089.                         END;
  1090.                         WaitAck := (errcheck= ZCRCQ) OR (errcheck= ZCRCW);
  1091.               |SendEOF: txhdr.P := txpos;
  1092.                         ZSendHeader(zeof);
  1093.                         INC(SendState);
  1094.                         WaitAck := TRUE;
  1095.               |EOFSent: CASE c OF
  1096.                              zack: SendState := SendEOF; (* await response *)
  1097.                            |zrpos: SendState := SendDHdr;(* receiver not done*)
  1098.                               ELSE RETURN c
  1099.                         END
  1100.          END (* CASE *)
  1101.     END (* Main LOOP *)
  1102. END ZSendFileData;
  1103.  
  1104. BEGIN (* ZSendFile *)
  1105.     txpos := 0;
  1106.     txhdr.P := 0;
  1107.     txhdr.ZFile.CFlags := CfResume;
  1108.     ZSendHeader(zfile);
  1109.     ZSendData(Buffer, BlockZeroLen, ZCRCW);
  1110.     StartTimer(ForTransfer);
  1111.     StartTimer(ForPacket);
  1112.     LOOP
  1113.          CASE ZGetHeader() OF
  1114.             zcan,
  1115.     disconnected,
  1116.         canceled,
  1117.         timedout,
  1118.             zfin,
  1119.        userabort,
  1120.            zabort: RETURN zerror;
  1121.           |zrinit: ;(*null; stay in loop *)
  1122.             |zcrc: txhdr.P := ZFileCRC32(Fi);
  1123.                    ZSendHexHeader(zcrc)
  1124.            |zskip: RETURN zskip;
  1125.            |zrpos: Seek(Fi,rxhdr.P);
  1126.                    IF NOT OK THEN
  1127.                         StatusMessage('File positioning error', FALSE);
  1128.                         ZSendHexHeader(zferr);
  1129.                         RETURN zferr;
  1130.                    END;
  1131.                    txpos := rxhdr.P;
  1132.                    RETURN ZSendFileData();
  1133.              |ELSE ZSendHeader(zfile);
  1134.                    ZSendData(Buffer, BlockZeroLen, ZCRCW);
  1135.          END (*CASE*)
  1136.     END (* LOOP *)
  1137. END ZSendFile;
  1138.  
  1139. VAR Cd : CmdType; FileName: PathTail; GotFile: BOOLEAN;
  1140. BEGIN
  1141.     rxtimeout := 192 >> ORD(QCDefPtr^.baud);
  1142.     IF rxtimeout < 10 THEN
  1143.          rxtimeout := 10
  1144.     END;
  1145.     HdrErrCount := 600 << ORD(QCDefPtr^.baud);
  1146.     WHILE CommRdData( 0 ) < ComAbort DO END; (* flush *)
  1147.     FlushLog;
  1148.     NEW( Buffer );
  1149.     StartDisplay( TRUE, ZModem, FALSE );
  1150.     ZSendHeader := ZSendHeader16;
  1151.     ZSendData  := ZSendDa16;
  1152.     MaxLength := ZBUFSIZE; (* assumes maximum *)
  1153.     IF NOT GetReceiverInfo() THEN
  1154.          DISPOSE( Buffer );
  1155.          StopDisplay;
  1156.          RETURN
  1157.     END;
  1158.     IF (MaxLength = 0) OR (MaxLength > ZBUFSIZE) THEN
  1159.         MaxLength := ZBUFSIZE (* if can't user receiver info, use ours *)
  1160.     END;
  1161.     IF QCDefPtr^.baud < 3 (*2400*) THEN
  1162.         BlockLength := 256
  1163.     ELSIF QCDefPtr^.baud > 4 THEN
  1164.         BlockLength := MaxLength;
  1165.     ELSE
  1166.         BlockLength := 512
  1167.     END;
  1168.     LOOP
  1169.          Fi := Open(ThisFile^.Name);
  1170.          IF Fi < MAX(CARDINAL) THEN
  1171.               BlockZeroLen :=
  1172.                    CreateBlock[ZModem](ThisFile^.Name, FileName, Buffer );
  1173.               GotFile := BlockZeroLen > 0
  1174.          ELSE
  1175.               GotFile := FALSE;
  1176.          END;
  1177.          IF NOT GotFile THEN
  1178.               StatusMessage('Unable to find or open file', FALSE);
  1179.               SendAckExit;
  1180.               EXIT
  1181.          END;
  1182.          ShowFileName(ThisFile^.Name, FALSE);
  1183.          DataRegisters[FALSE, DataLeft] := Size(Fi);
  1184.          ShowTimeLeft( FALSE );
  1185.          Cd := ZSendFile();
  1186.          Close(Fi);
  1187.          ShowTransferTime;
  1188.          ThisFile := ThisFile^.Next;
  1189.          IF (Cd = zrinit) OR (Cd = zskip) THEN
  1190.               IF ThisFile = NIL THEN
  1191.                    SendAckExit;
  1192.                    EXIT
  1193.               END
  1194.          ELSE
  1195.               ZSendCan;
  1196.               EXIT
  1197.          END
  1198.    END;
  1199.    DISPOSE( Buffer );
  1200.    StopDisplay;
  1201. END SendZmodem;
  1202.  
  1203. END QCzm.